home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / TEMPLATE.ZIP / AS_MENU.COD < prev    next >
Text File  |  1994-10-12  |  22KB  |  881 lines
  1. //
  2. // Module Name: AS_MENU.COD
  3. // Description: Define Application menus and program structure.
  4. //
  5.  
  6. dBASE 5.0 Application Template
  7. ---------------------------------------
  8. Version 5.0
  9. Borland International (c) 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994
  10.  
  11. {include "applctn.def"
  12.  include "builtin.def"
  13.  
  14.  if getenv("dtl_debug") then
  15.    debug(2)
  16.    breakpoint( pick_debug )
  17.  endif
  18.  var  bnl_formname,     // Name of BNL file to newframe if argument() has value
  19.       arg_list;
  20.  
  21.  arg_list = alltrim(argument())
  22.  
  23.  if arg_list != "" then
  24.    bnl_formname = token( ",", arg_list, 1 )
  25.    if !newframe( bnl_formname ) then
  26.      return -1;
  27.    endif
  28.  endif
  29.  
  30.  enum exceed_limit = "Esta aplicación excede el límite de cinco menús del ejemplo.",
  31.       demo_version = 0;
  32.  
  33.  var strng,      // temporary string storage
  34.      strng1,     // menus to call
  35.      mainmenu,   // name of main menu
  36.      mnuname,    // current menu name
  37.      padmenu,    // padmenu name to deactivate
  38.      pulldown,   // flag indicating pad is a pulldown
  39.      mnu_messag, // dBASE message string variable
  40.      color,      // Used to grab menu colors
  41.      cnt,        // incremental counter for items in menus
  42.      count,      // temporary counter
  43.      prgcnt,     // counter for actions and help
  44.      muser,      // multi user switch
  45.      mactions,   // menu actions
  46.      x,          // temporary numeric variable
  47.      ask_user,   // string for askuser function
  48.      appl_name,  // application name
  49.   default_drive, // dBASE default drive
  50.      mpath,      // DOS path
  51.      file,       // DOS file
  52.      itemdbf,    // flag to indicate whether database changed during a batch
  53.      exclflg,    // flag for exclusive use of database needed
  54.      mtype,      // Menu TYPE - converted to a character
  55.      display,    // monitor display type
  56.      scrn_size,  // number of rows of monitor display type
  57.      midentify,  // Identify string for structure pick list
  58.      windowvar,  // whether to declare lc_window private or not
  59.      menusave,   // use SAVE SCREEN or Redraw horizontal bar menus
  60.      browse_no_clear, // clear popup for browse noclear action
  61.      is_popups,  // flag to indicate whether there are popups in the app.
  62.      is_menus    //       "          "          "      menus       "
  63. ;
  64.  // Used in as_help.cod
  65.  var rowpoint,menucnt;
  66.  // vars below used to compare Menu & Item view/ndx's to open
  67.  var global_view, global_ndx, global_ord, gc_view, gc_ndx, gc_ord;
  68.  var itemview, itemndx, itemord, lc_view, lc_ndx, lc_ord;
  69.  // vars for global use of author, copyright & db Version
  70.  var author,copyright,dbVersion;
  71.  // foreach variables
  72.  var flds,j,k,m,mtree;
  73.  //
  74.  // Some initial environment testing follows
  75.  //
  76.  screen_size();
  77.  
  78.  default_drive = STRSET(_defdrive);
  79.  if FILEDRIVE(Menu_Name) || !default_drive then
  80.    appl_name=Menu_Name;
  81.  else
  82.    appl_name=default_drive + ":" + Menu_Name;
  83.  endif
  84.  
  85.  if Menu_Type != app then
  86.    PAUSE(app_class);
  87.    GOTO NoGen;
  88.  endif
  89.  
  90.  if not FILEEXIST(Menu_Main) then
  91.    pause(no_main_menu+any_key);
  92.    return 8; // resource file not found
  93.  endif
  94.  
  95.  if fileexist(appl_name+".prg") && NUMSET(_safety) then
  96.  retry:
  97.    ask_user = ASKUSER("El programa "+appl_name+".PRG ya existe...¿Sustituir?  (S/N)","N",1);
  98.    if not at(upper(ask_user),"SN") then GOTO retry endif
  99.    if upper(ask_user) == "N" then
  100.      pause(gen_request+any_key);
  101.      GOTO NoGen;
  102.    endif
  103.  endif
  104.  if getenv("DTL_APGEN") then
  105.    menusave=" ";
  106.  else
  107.    menusave="N"
  108.  endif
  109.  do while not at(upper(menusave),"SN")
  110.    menusave=ASKUSER(
  111.      "¿S - Usar mandato SAVE SCREEN (4k por submenú) o N - Dibujar menús?",
  112.      "N",1);
  113.    if not at(upper(menusave),"SN") then
  114.      menusave=" ";
  115.    endif
  116.  enddo
  117.  if upper(menusave) == "S" then
  118.    menusave=1
  119.  else
  120.    menusave=0
  121.  endif
  122.  //
  123.  // Initialize some variables
  124.  //
  125.  count=1;
  126.  prgcnt=1;
  127.  itemdbf=0;
  128.  muser=0;
  129.  pulldown=0;
  130.  mnu_messag="'Situar barra selección:  '+CHR(27)+CHR(26)+CHR(25)+CHR(24)+'  Seleccionar:  '"+
  131.     "+CHR(17)+CHR(196)+CHR(217)+'  Ayuda: F1'";
  132.  author=appl_Authr;
  133.  copyright=appl_cpyrt;
  134.  dbVersion=Appl_Versn;
  135.  global_View=Appl_View;  // Set global application dbf/view
  136.  global_NDX=Appl_NDX;    // Set global application ndx
  137.  global_Ord=Appl_Order;  // Set global application Order
  138.  mtype="";
  139.  padmenu="";
  140.  //-----------------------------------
  141.  // Create application startup program
  142.  //-----------------------------------
  143.  if not CREATE(appl_name+".prg") then;
  144.    PAUSE(fileroot(appl_name)+".prg"+read_only+any_key);
  145.    GOTO NoGen
  146.  endif
  147.  fileerase(appl_name+".dbo");}
  148. *{replicate("-",69)}
  149. *  Programa.....: {fileroot(appl_name)}.PRG
  150. {do_as_headr( makec( @TREE ) );}
  151. * Descripción..: Rutina principal para el sistema de menús
  152. *{replicate("-",69)}
  153. {LMARG(3);}
  154.  
  155. *-- Establecimiento del entorno
  156. SET CONSOLE OFF
  157. IF TYPE("gn_ApGen")="U"
  158.   CLEAR WINDOWS
  159.   CLEAR ALL
  160.   CLOSE ALL
  161.   CLOSE PROCEDURE
  162.   gn_ApGen=1
  163. ELSE
  164.   gn_ApGen=gn_ApGen+1
  165.   IF gn_ApGen > 4
  166.     Do Pause WITH "Se ha sobrepasado el nivel máximo de anidamientos en la Aplicación."
  167.     RETURN
  168.   ENDIF
  169.   PRIVATE gn_oldsize
  170.   gn_oldsize=gn_scrsize
  171.   PRIVATE gc_bell, gc_carry, gc_clock, gc_century, gc_confirm, gc_deli,;
  172.           gc_safety, gc_status, gc_score, gc_talk, gl_leave, gc_prognum,;
  173.           gc_quit, gc_color, gc_display, gl_color, gl_batch, gn_scrsize
  174. ENDIF
  175. *-- Almacenar algunos SETs en variables
  176. gc_bell   =SET("BELL")
  177. gc_carry  =SET("CARRY")
  178. gc_clock  =SET("CLOCK")
  179. gc_color  =SET("ATTRIBUTE")
  180. gc_century=SET("CENTURY")
  181. gc_confirm=SET("CONFIRM")
  182. gc_cursor =SET("CURSOR")
  183. gc_deli   =SET("DELIMITERS")
  184. gc_display=SET("DISPLAY")
  185. gc_safety =SET("SAFETY")
  186. gc_status =SET("STATUS")
  187. gc_score  =SET("SCOREBOARD")
  188. gc_talk   =SET("TALK")
  189.  
  190. {
  191.   Set_Screen_Mode();
  192. }
  193. SET CONSOLE ON
  194. {if !Set_Bell then
  195.    if Set_BellFR and Set_BellDr then}
  196. SET BELL TO {Set_BellFR},{Set_BellDr}
  197. {  endif
  198.  endif}
  199. SET BELL {if Set_Bell}OFF{else}ON{endif}
  200. SET CARRY {if Set_Carry}ON{else}OFF{endif}
  201. SET CENTURY {if Set_Centry}ON{else}OFF{endif}
  202. SET CLOCK OFF
  203. SET CONFIRM {if Set_Confrm}ON{else}OFF{endif}
  204. {if Run_Drive then}
  205. SET DEFAULT TO {UPPER(Run_Drive)}
  206. {endif}
  207. SET DELIMITERS TO \
  208. {if not AT(CHR(34),Set_DelChr) then}"{Set_DelChr}"
  209. {  goto deliok;
  210.  endif
  211.  if not AT("'",Set_DelChr) then}'{Set_DelChr}'
  212. {  goto deliok;
  213.  endif
  214.  if !AT("[",Set_DelChr) or !AT("]",Set_DelChr) then}[{Set_DelChr}]
  215. {  goto deliok;
  216.  endif
  217. }
  218. ""
  219. {deliok:}
  220. SET DELIMITERS {if Set_Delim}ON{else}OFF{endif}
  221. SET DEVICE TO SCREEN
  222. SET ESCAPE {if Set_Escape}OFF{else}ON{endif}
  223. SET EXCLUSIVE OFF
  224. SET LOCK ON
  225. SET MESSAGE TO ""
  226. {if Run_Path then}
  227. SET PATH TO {Run_Path}
  228. {endif}
  229. SET PRINT OFF
  230. SET REPROCESS TO 4
  231. SET SAFETY {if Set_Safety}OFF{else}ON{endif}
  232. SET TALK OFF
  233.  
  234. *-- Inicializar variables globales
  235. gl_batch=.F.        && se está ejecutando un proceso secuencial
  236. gl_color= ISCOLOR() .AND. SET("DISPLAY") <> "CGAMONO"
  237. gn_error=0          && si no es 0, ha ocurrido un error
  238. gn_scrsize={scrn_size}       && número de líneas de pantalla
  239. gn_send=0           && valor devuelto por los menús de desplazamiento
  240. gn_trace=1          && nivel de rastreo, cuando se cambie la plantilla
  241. gc_brdr='1'         && borde cuando de dibujan recuadros
  242. gc_dev='CON'        && dispositivo de impresión - Ver Proc. PrintSet
  243. gl_leave=.f.        && abandonar la aplicación
  244. gc_prognum='  '     && contador interno para los anidamientos de menús
  245. gc_quit=' '         && varmem para volver al programa que llamó
  246. gc_scope=''         && ámbito, FOR y WHILE de la ventana en ejecución
  247. listval='NO_FIELD'  && valor de la lista de opciones
  248.  
  249. *-- Suprímase el asterisco para activar el reloj
  250. * SET CLOCK TO
  251.  
  252. *-- Limpia la pantalla
  253. SET COLOR TO
  254. CLEAR
  255. SET SCOREBOARD OFF
  256. SET STATUS OFF
  257.  
  258. *-- Definición de menús
  259. DO MPDEF{tabto(41)}&& Proceso para definir los menús
  260.  
  261. *-- Ejecutar el menú principal
  262. DO WHILE .NOT. gl_leave
  263.   DO {Appl_Menu} WITH "{if !Appl_Type then}B{else} {endif}00"
  264.   IF gc_quit = 'Q'
  265.     EXIT
  266.   ENDIF
  267.   gl_leave = _NodShake( " ;   ¿Desea abandonar la aplicación?   ", ;
  268.                         13, 18, 2, 44, .T. )
  269. ENDDO
  270.  
  271. *-- Restaura el entorno
  272. DEACTIVATE WINDOW FullScr
  273. ?? Color(gc_color)
  274. gn_ApGen=gn_ApGen-1
  275. SET BELL  &gc_bell.
  276. SET CARRY &gc_carry.
  277. SET CLOCK &gc_clock.
  278. SET CENTURY &gc_century.
  279. SET CONFIRM &gc_confirm.
  280. SET CURSOR  &gc_cursor.
  281. SET DELIMITERS &gc_deli.
  282. SET DISPLAY TO &gc_display.
  283. SET STATUS &gc_status.
  284. SET SAFETY &gc_safety.
  285. SET SCOREBOARD &gc_score.
  286. SET TALK   &gc_talk.
  287.  
  288. IF gn_Apgen < 1
  289.   ON KEY LABEL F1
  290.   CLEAR WINDOWS
  291.   CLEAR ALL
  292.   CLOSE ALL
  293.   CLOSE PROCEDURE
  294.   SET ESCAPE ON
  295.   SET MESSAGE TO ""
  296.   CLEAR
  297. ELSE
  298.   DEFINE WINDOW FullScr FROM 0,0 TO gn_oldsize+3,79 NONE
  299.   DEFINE WINDOW Savescr FROM 0,0 TO gn_oldsize,79 NONE
  300.   DEFINE WINDOW Helpscr FROM 0,0 TO gn_oldsize,79 NONE
  301.   ACTIVATE WINDOW FullScr
  302. ENDIF
  303.  
  304. {LMARG(1);}
  305. RETURN
  306. *-- EOP: {appl_name}
  307.  
  308. //--------------------------------
  309. // Add Application Procedure file
  310. // contains common programs
  311. //--------------------------------
  312. //
  313. {include "as_proc.cod";}
  314. PROCEDURE MPDEF
  315. *{replicate("-",69)}
  316. * Programa.....: MPDEF
  317. {do_as_headr( makec( @TREE ) );}
  318. * Descripción..: Define todos los menús del sistema para {appl_name}
  319. *{replicate("-",69)}
  320. {LMARG(3);}
  321.  
  322. IF gl_color
  323.   SET COLOR OF NORMAL TO {color=color(Clr_Text)}
  324.   SET COLOR OF MESSAGES TO {color(Clr_Messages)}
  325.   SET COLOR OF TITLES TO {color(Clr_Heading)}
  326.   SET COLOR OF HIGHLIGHT TO {color(Clr_Hghlight)}
  327.   SET COLOR OF BOX TO {color(Clr_Box)}
  328.   SET COLOR OF INFORMATION TO {color(Clr_Info)}
  329.   SET COLOR OF FIELDS TO {color(Clr_Fields)}
  330. ENDIF
  331. CLEAR
  332.  
  333. {if Disp_Sign then}
  334. *-- Pantalla de presentación
  335. //
  336. // Draw border
  337. //
  338. SET BORDER TO
  339. {if Mnu_Border != 3 then}
  340. @ {row1()},{col1()} TO {row2()},{col2()}\
  341. {case Mnu_Border of
  342.  0: // Panel}
  343.  PANEL\
  344. {2: // Double}
  345.  DOUBLE\
  346. {endcase}
  347.  COLOR {color(Clr_Box)}
  348. {endif}
  349. //
  350. // Display text
  351. //
  352. {foreach TEXT_ELEMENT flds}
  353. @ {row1()+Row_Positn},{col1()+Col_Positn} SAY {out_text_with_deli(flds);}
  354. {next flds;}
  355. @ {row1()+1},{col1()+1} FILL TO {row2()-1},{col2()-1} \
  356. COLOR {color(Clr_Messages)}
  357. //
  358. // Wait for a return key
  359. //
  360. @ {scrn_size+3},30 SAY " Pulse "+CHR(17)+CHR(196)+CHR(217)+" para continuar. "
  361. SET CONSOLE OFF
  362. DO Wait4Key
  363. SET CONSOLE ON
  364. CLEAR
  365.  
  366. {endif //  if Disp_Sign}
  367. //
  368. // default window if none defined for action
  369. //
  370. *-- Evita que se borren los menús al ejecutarse los mandatos:
  371. *-- SET STATUS y SET SCOREBOARD
  372. DEFINE WINDOW FullScr FROM 0,0 TO {scrn_size+3},79 NONE
  373. *-- Ventana para ejecución y procesos secuenciales
  374. DEFINE WINDOW Savescr FROM 0,0 TO {scrn_size},79 NONE
  375. *-- F1 Ayuda
  376. DEFINE WINDOW Helpscr FROM 0,0 TO {scrn_size},79 NONE
  377. IF gn_ApGen=1
  378.   *-- Ventana de mensajes
  379.   DEFINE WINDOW Pause FROM 15,00 TO 19,79 DOUBLE
  380. ENDIF
  381. ACTIVATE WINDOW FullScr
  382. @ {scrn_size+3},00
  383. @ {scrn_size+2},00 SAY "Cargando..."
  384. //
  385. {x=LEN(Menu_Main) - 4;
  386.  if FILEDRIVE(Menu_Main) || !default_drive then
  387.    mainmenu=SUBSTR(Menu_Main,1,x);
  388.  else
  389.    mainmenu=default_drive + ":" + SUBSTR(Menu_Main,1,x);
  390.  endif
  391.  //
  392.  // Put first menu on black board before fortree loop
  393.  //
  394.  newframe(Menu_Main);
  395.  if not CREATE(mainmenu+".prg") then;
  396.    PAUSE(fileroot(mainmenu)+".prg"+read_only+any_key);
  397.    GOTO NoGen
  398.  endif
  399.  if not CREATE("$$$HELP.TMP") then;
  400.    PAUSE("$$$HELP.TMP"+read_only+any_key);
  401.    GOTO NoGen
  402.  endif
  403.  fileerase(mainmenu+".dbo");
  404. }
  405. //
  406. {foreach TREE mtree
  407.  if demo_version == 1 then
  408.    if COUNTC(mtree) > 5 then
  409.      pause(exceed_limit+any_key);
  410.      goto finish;
  411.    endif
  412.  endif
  413.  x=1;
  414.  strng1 = mactions = "";
  415.  itemview = itemndx = itemord = 0;
  416.  mnuname=Menu_Name;
  417.  mtype=STR(Menu_Type);
  418.  prgcnt=COUNTC(mtree);
  419.  midentify="";
  420.  
  421.  LMARG(3);
  422.  //
  423.  // Write Menu definition program
  424.  //
  425.  APPEND(appl_name+".prg");}
  426. SET BORDER TO \
  427. {case Mnu_Border of
  428.  0: // Panel}
  429. PANEL
  430. {1: // Single}
  431. SINGLE
  432. {2: // Double}
  433. DOUBLE
  434. {3: // None}
  435. NONE
  436. {endcase
  437.  case Menu_Type of
  438.  2: // Popup define
  439.    is_popups=1;
  440.    browse_no_clear = "";}
  441.  
  442. *-- Menú de ventana
  443. DEFINE POPUP {mnuname} FROM {row1()},{col1()} TO {row2()},{col2()} ;
  444. MESSAGE {if Menu_Prmpt then}"{Menu_Prmpt}"{else}{mnu_messag}{endif}
  445. //
  446. {  foreach FLD_ELEMENT flds}
  447. //
  448.   DEFINE BAR {Row_Positn} OF {mnuname} PROMPT "{Fld_Pictur}" \
  449. {if Item_Prmpt then}MESSAGE "{Item_Prmpt}"{endif} \
  450. {if ItemSkipIf then}SKIP FOR\
  451.  {ItemSkipIf}{else}{if !Menu_Act then} SKIP{endif}{endif}
  452. {if Item_Ovride == 1 then itemover(flds); endif}
  453. {if Brow_Clear == 1 then
  454.     browse_no_clear = " BLANK " ;
  455.  endif}
  456. {  next flds;}
  457. //
  458. // set call to action procedure.
  459. //
  460. ON SELECTION POPUP {mnuname} {browse_no_clear}DO ACT0{prgcnt}
  461. {  browse_no_clear = "";}
  462. //
  463. // File, Structure and Value pick lists all make use of a variable listval.
  464. // --------------------------------------------------------------------
  465. {3: // Files
  466.    is_popups=1;}
  467. DEFINE POPUP {mnuname} FROM {row1()},{col1()} TO {row2()},{col2()} \
  468. PROMPT FILES LIKE {if Pick_File then}{Pick_File} {else}*.* {endif};
  469. MESSAGE \
  470. {  foreach FLD_ELEMENT flds
  471.      strng=Item_Prmpt;
  472.    next flds;
  473.  if strng then}
  474. "{strng}"
  475. {else
  476.    if Menu_Prmpt then}
  477. "{Menu_Prmpt}"
  478. {  else
  479.  mnu_messag}
  480.  
  481. {  endif
  482.  endif}
  483. ON SELECTION POPUP {mnuname} DO ACT0{prgcnt}
  484. {  foreach FLD_ELEMENT flds
  485. if Item_Ovride == 1 then itemover(flds); endif
  486.   next flds;
  487. //
  488.  4: // Structure
  489.    is_popups=1;}
  490. DEFINE POPUP {mnuname} FROM {row1()},{col1()} TO {row2()},{col2()} \
  491. PROMPT STRUCTURE ;
  492. MESSAGE \
  493. {  foreach FLD_ELEMENT flds
  494.     strng=Item_Prmpt;
  495.    next flds;
  496.  if strng then}
  497. "{strng}"
  498. {else}
  499. {  if Menu_Prmpt then}
  500. "{Menu_Prmpt}"
  501. {  else
  502.  mnu_messag}
  503.  
  504. {  endif
  505.  endif}
  506. ON SELECTION POPUP {mnuname} DO ShowPick
  507. {  foreach FLD_ELEMENT flds
  508.  if Item_Ovride == 1 then itemover(flds); endif
  509.  midentify=PICK_FIELD;
  510.    next flds;}
  511. //
  512. {5: // Values
  513.    is_popups=1;
  514.    if !Pick_Value || UPPER(Pick_Value) == "&LISTVAL" then}
  515. DEFINE POPUP {mnuname} FROM {row1()},{col1()}
  516.   DEFINE BAR 1 OF {mnuname} PROMPT "  Ningún campo definido " SKIP
  517. {  else}
  518. DEFINE POPUP {mnuname} FROM {row1()},{col1()} TO {row2()},{col2()} \
  519. PROMPT FIELD {Pick_Value} ;
  520. MESSAGE \
  521. {    foreach FLD_ELEMENT flds
  522.        strng=Item_Prmpt;
  523.      next flds;
  524.      if strng then}
  525. "{strng}"
  526. {    else
  527.        if Menu_Prmpt then}
  528. "{Menu_Prmpt}"
  529. {      else
  530.  mnu_messag}
  531.  
  532. {      endif
  533.      endif
  534.    endif}
  535. ON SELECTION POPUP {mnuname} DO ACT0{prgcnt}
  536. {  foreach FLD_ELEMENT flds
  537.  if Item_Ovride == 1 then itemover(flds); endif
  538.    next flds;
  539. // --------------------------------------------------------------------
  540. //
  541.  7: // Bar define
  542.    is_menus=1;}
  543.  
  544. *-- Menú de línea
  545. DEFINE MENU {mnuname} MESSAGE \
  546. {  if Menu_Prmpt then}
  547. "{Menu_Prmpt}"
  548. {  else}
  549. 'Situar barra de selección con: '+CHR(27)+CHR(26)+' -<Enter> para seleccionar opción - <F1>Ayuda'
  550. {  endif
  551.     x=0;
  552.     pulldown=0;
  553.  
  554.     foreach FLD_ELEMENT flds
  555.       ++x;
  556.       //
  557.       // if for some reason there is an entry in the list
  558.       // without text ie. corrupted data, skip it.
  559.       //
  560.       if !Fld_Pictur goto loophpad;}
  561. //
  562. // use the menu name and the letter option on each pad
  563. //
  564.   DEFINE PAD PAD_{x} OF {mnuname} PROMPT "{Fld_Pictur}" \
  565. AT {Row_Positn+Row1()},{Col_Positn+Col1()} \
  566. {     if Item_Prmpt then}MESSAGE "{Item_Prmpt}"{endif}
  567. //
  568. // if the action is to open a menu then find out whether it's a popup
  569. //
  570. {     if Menu_Act == 1 && Open_Type then}
  571. //
  572. // if it is a popup is it a pulldown or not.
  573. //
  574.   ON {if Pldwn_Menu then}SELECTION {endif}\
  575. PAD PAD_{x} OF {mnuname} \
  576. {if Pldwn_Menu then}
  577. DO ACT0{prgcnt}
  578. {else}
  579. ACTIVATE POPUP {Open_Menu}
  580. {endif
  581.       else
  582.  if Item_Ovride == 1 then itemover(flds); endif}
  583. //
  584. // set call to action procedure.
  585. //
  586.   ON SELECTION PAD PAD_{x} OF {mnuname} DO ACT0{prgcnt}
  587. {     endif
  588.       loophpad:
  589.     next flds;
  590.   btch:}
  591.  
  592. *-- {mnuname} - Objeto de proceso secuencial.
  593. { otherwise:}
  594.  
  595. *-- {mnuname} - objeto no definido todavía.
  596. {endcase // endcase Menu_Type}
  597. ?? "."
  598.  
  599. //-------------------------------------------
  600. // Create program control loop for each menu.
  601. //-------------------------------------------
  602. {
  603.  APPEND(mainmenu+".prg");
  604.  
  605. }
  606. {LMARG(1);}
  607. PROCEDURE {mnuname}
  608. PARAMETER entryflg
  609. *{replicate("-",69)}
  610. * Programa.....: {mnuname}.PRG
  611. {do_as_headr( flds );}
  612. * Descripción..: Acciones de menú
  613. *{replicate("-",69)}
  614. {LMARG(3);}
  615. PRIVATE gc_prognum\
  616. {if menusave then}
  617. , lc_ApGen\
  618. {endif}
  619.  
  620. gc_prognum="0{prgcnt}"
  621. {if menusave then}
  622. lc_ApGen=LTRIM(STR(gn_ApGen))+"{prgcnt}"
  623. {endif}
  624. {if prgcnt == 1 then}
  625. SET COLOR OF NORMAL TO {color}
  626. CLEAR
  627. {  if !menusave then}
  628. PRIVATE lc_ApGen
  629. lc_ApGen=LTRIM(STR(gn_ApGen))
  630. {  endif}
  631. {endif}
  632. {if Menu_Type == s_pick then}
  633.  
  634. IF LEFT(entryflg,1)="A"
  635.   DO ACT0{prgcnt}
  636.   RETURN
  637. ENDIF
  638. {endif}
  639.  
  640. {if Menu_Type == bar then}
  641. SAVE SCREEN TO SET0{prgcnt}&lc_Apgen.
  642. {endif}
  643. DO SET0{prgcnt // global counter tracks number of procedures}
  644. IF gn_error > 0
  645.   gn_error=0
  646.   RETURN
  647. ENDIF
  648. {if Menu_Before then}
  649.  
  650. *-- Código anterior al menú
  651. { foreach Menu_Before
  652.     print(Menu_Before+CHR(10));
  653.   next
  654. }
  655.  
  656. {endif}
  657. {if menusave && Menu_type == bar then}
  658. SET BORDER TO
  659. {  if Mnu_Border != 3 then}
  660. @ {row1()},{col1()} TO {row2()},{col2()}\
  661. {    case Mnu_Border of}
  662. {    0:}
  663.  PANEL\
  664. {    2:}
  665.  DOUBLE\
  666. {    endcase}
  667.  COLOR {color(Clr_Box)}
  668. {  endif}
  669. @ {row1()+1},{col1()+1} CLEAR TO {row2()-1},{col2()-1}
  670. @ {row1()+1},{col1()+1} FILL TO {row2()-1},{col2()-1} \
  671. COLOR {color(Clr_Messages)}
  672. {  foreach FLD_ELEMENT}
  673. @ {Row_Positn+Row1()},{Col_Positn+Col1()} SAY "{Fld_Pictur}" \
  674. COLOR {color(Clr_Messages)}
  675. {  next  }
  676. {endif}
  677.  
  678. {if Menu_Type == s_pick then}
  679. lc_fldlst=''
  680. {  if midentify then}
  681. SET FIELDS TO {midentify}
  682.  
  683. {  endif}
  684. ON KEY LABEL CTRL-W DEACTIVATE POPUP
  685. IF TYPE("lc_window")="U"
  686.   DEFINE WINDOW ShowPick FROM 17,0 TO 21,60 DOUBLE
  687.   ACTIVATE WINDOW ShowPick
  688. ENDIF
  689. ACTIVATE SCREEN
  690. {endif
  691.  if Menu_Type == btch then // batch process}
  692. //
  693. // Perform batch actions
  694. //
  695. lc_popmenu="{mnuname}"
  696. DO ACT0{prgcnt}
  697. {else}
  698. //
  699. // Pick_Value has the field the pick list is based on
  700. //
  701. {  if Menu_Type == v_pick then}
  702. SET BORDER TO \
  703. {case Mnu_Border of
  704.  0: // Panel}
  705. PANEL
  706. {1: // Single}
  707. SINGLE
  708. {2: // Double}
  709. DOUBLE
  710. {3: // None}
  711. NONE
  712. {endcase}
  713. DEFINE POPUP {mnuname} FROM {row1()},{col1()} TO {row2()},{col2()} \
  714. PROMPT FIELD {if Pick_Value then}{Pick_Value} {else}&listval. {endif}\
  715. MESSAGE \
  716. {  foreach FLD_ELEMENT flds
  717.      strng=Item_Prmpt;
  718.    next flds;
  719.  if strng then}
  720. "{strng}"
  721. {else
  722.    if Menu_Prmpt then}
  723. "{Menu_Prmpt}"
  724. {  else
  725.  mnu_messag}
  726.  
  727. {  endif
  728.  endif}
  729. ON SELECTION POPUP {mnuname} DO ACT0{prgcnt}
  730. SET BORDER TO
  731. {  endif}
  732. //
  733. // Activate the pad menu or popup.
  734. //
  735. ACTIVATE {if Menu_Type == bar then}MENU {else}POPUP {endif}{mnuname}
  736. {endif}
  737.  
  738. {if Menu_Type == bar then}
  739. RESTORE SCREEN FROM SET0{prgcnt}&lc_Apgen.
  740. RELEASE SCREEN SET0{prgcnt}&lc_apgen
  741. {endif
  742.  if Menu_Type == s_pick then}
  743. IF TYPE("lc_window")="U"
  744.   DEACTIVATE WINDOW ShowPick
  745.   RELEASE WINDOW ShowPick
  746. ENDIF
  747. ON KEY LABEL CTRL-W
  748. IF RIGHT(lc_fldlst,1)="," .AND. LASTKEY() <> 27
  749.   listval=LEFT(lc_fldlst,LEN(lc_fldlst)-1)
  750.   DO ACT0{prgcnt}
  751. ENDIF
  752.  
  753. {endif}
  754. {if Menu_After then}
  755. *-- Posterior al Menú
  756. { foreach Menu_After
  757.     print(Menu_After+CHR(10));
  758.   next
  759. }
  760.  
  761. {endif}
  762. {LMARG(1);}
  763. RETURN
  764. *-- EOP: {mnuname}
  765.  
  766. // Setup procedure
  767. // 1) Set help file to call
  768. // 2) set colors
  769. // 3) ? menu level database
  770. // 4 conditional before code (flag var to handle calls to other menus)
  771. //
  772. {include "as_setup.cod"
  773.  nosub:
  774.  //
  775.  // Actions procedure
  776.  //
  777.  include "as_actn.cod"
  778.  //
  779.  // Help procedure
  780.  //
  781.  APPEND("$$$HELP.TMP");
  782.  //
  783.  include "as_help.cod"
  784.  
  785.  next mtree;
  786.  
  787.  finish:
  788.  //
  789.  // End of fortree loop
  790.  //
  791.  APPEND(appl_name+".prg");
  792. }
  793. {LMARG(1);}
  794. RETURN
  795. *-- EOP: MPDEF.PRG
  796.  
  797. //
  798. // Top half of help
  799. //
  800. PROCEDURE 1HELP1
  801. *--------------------------------------------------------------------
  802. * Gestión de F1 - Ayuda durante la ejecución del programa
  803. *--------------------------------------------------------------------
  804. {LMARG(3);}
  805. PRIVATE lc_popmenu, ll_errbox, ll_status
  806.  
  807. ON KEY LABEL F1
  808. {if is_popups || is_menus then}
  809. lc_popmenu=\
  810. {if is_popups && is_menus then}
  811. IIF( "" = POPUP(), MENU(), POPUP() )
  812. {else}
  813. {  if is_popups then}
  814. POPUP()
  815. {  endif}
  816. {  if is_menus then}
  817. MENU()
  818. {  endif}
  819. {endif}
  820. {endif}
  821. ll_status = SET( "STATUS" ) = "ON"
  822. IF ll_status
  823.   SAVE SCREEN TO ls_status
  824.   SET STATUS OFF
  825.   RESTORE SCREEN FROM ls_status
  826. ELSE
  827.   ACTIVATE WINDOW Helpscr
  828. ENDIF
  829. SET ESCAPE OFF
  830. ACTIVATE SCREEN
  831. @ 0,0 CLEAR TO 21,79
  832. @ 1,0 TO 21,79 COLOR {color(Clr_Box)}
  833. @ {scrn_size+3},00
  834. @ 0,0 SAY ""
  835. ll_errbox = .F.
  836. DO CASE
  837. //
  838. // end of top half
  839. //
  840. {COPY("$$$HELP.TMP");}
  841. //
  842. // Bottom half of help
  843. //
  844.   OTHERWISE
  845.     DO _Err_Box WITH "Nombre de menú desconocido, no hay ayuda definida."
  846.     ll_errbox = .T.
  847. ENDCASE
  848.  
  849. IF .NOT. ll_errbox
  850.   @ {scrn_size+3},26 SAY "Pulse cualquier tecla para continuar..."
  851.   SET CONSOLE OFF
  852.   DO Wait4Key
  853.   SET CONSOLE ON
  854. ENDIF
  855.  
  856. SET ESCAPE {IF set_escape}OFF{ELSE}ON{ENDIF}
  857. @ {scrn_size+3},00
  858. IF ll_status
  859.   SET STATUS ON
  860.   RESTORE SCREEN FROM ls_status
  861.   RELEASE SCREEN ls_status
  862. ELSE
  863.   DEACTIVATE WINDOW Helpscr
  864. ENDIF
  865. ON KEY LABEL F1 DO 1HELP1
  866. {LMARG(1);}
  867. RETURN
  868. *-- EOP: 1HELP1
  869. {fileerase("$$$HELP.TMP");
  870.  pause(gen_complete+any_key);
  871. //
  872.  NoGen:
  873. //
  874.  return 0;
  875. //-----------------------------------
  876. // User defined function include file.
  877. //-----------------------------------
  878.  include "as_udf.cod";}
  879. // EOP AS_MENU.COD
  880.  
  881.